home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / siod / siod_v20.lha / siod.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-08-16  |  1.9 KB  |  95 lines
  1. /* Scheme In One Defun, but in C this time.
  2.  
  3.  *                        COPYRIGHT (c) 1989 BY                             *
  4.  *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
  5.  *        See the source file SLIB.C for more information.                  *
  6.  
  7. */
  8.  
  9. /*
  10.  
  11. gjc@paradigm.com
  12.  
  13. Paradigm Associates Inc          Phone: 617-492-6079
  14. 29 Putnam Ave, Suite 6
  15. Cambridge, MA 02138
  16.  
  17.   */
  18.  
  19. #include <stdio.h>
  20.  
  21. #include "siod.h"
  22.  
  23. /* This illustrates calling the main program entry points and enabling our
  24.    own example subrs */
  25.  
  26. main(argc,argv)
  27.  int argc; char **argv;
  28. {print_welcome();
  29.  process_cla(argc,argv);
  30.  print_hs_1();
  31.  init_storage();
  32.  init_subrs();
  33.  our_subrs();
  34.  repl_driver(1,1);
  35.  printf("EXIT\n");}
  36.  
  37. /* This is cfib, for compiled fib. Test to see what the overhead
  38.    of interpretation actually is in a given implementation 
  39.  */
  40.  
  41. LISP my_one;
  42. LISP my_two;
  43.  
  44. /*   (define (standard-fib x)
  45.        (if (< x 2)
  46.          x
  47.          (+ (standard-fib (- x 1))
  48.         (standard-fib (- x 2)))))  
  49. */
  50.  
  51. LISP cfib(x)
  52.      LISP x;
  53. {if NNULLP(lessp(x,my_two))
  54.    return(x);
  55.  else
  56.    return(plus(cfib(difference(x,my_one)),
  57.            cfib(difference(x,my_two))));}
  58.  
  59.  
  60. #ifdef vms
  61. #include <descrip.h>
  62. #include <ssdef.h>
  63. LISP sys_edit(fname)
  64.  LISP fname;
  65. {struct dsc$descriptor_s d;
  66.  long iflag;
  67.  if NTYPEP(fname,tc_symbol) err("filename not a symbol",fname);
  68.  d.dsc$b_dtype = DSC$K_DTYPE_T;
  69.  d.dsc$b_class = DSC$K_CLASS_S;
  70.  d.dsc$w_length = strlen(PNAME(fname));
  71.  d.dsc$a_pointer = PNAME(fname);
  72.  iflag = no_interrupt(1);
  73.  edt$edit(&d);
  74.  no_interrupt(iflag);
  75.  return(fname);}
  76.  
  77. LISP vms_debug(v)
  78.      LISP v;
  79. {lib$signal(SS$_DEBUG);
  80.  return(v);}
  81.  
  82. #endif
  83.  
  84. our_subrs()
  85. {my_one = flocons((double) 1.0);
  86.  my_two = flocons((double) 2.0);
  87.  gc_protect(&my_one);
  88.  gc_protect(&my_two);
  89.  init_subr("cfib",tc_subr_1,cfib);
  90. #ifdef vms
  91.  init_subr("edit",tc_subr_1,sys_edit);
  92.  init_subr("vms-debug",tc_subr_1,vms_debug);
  93. #endif
  94. }
  95.